home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / keytrap / KeyHook.dpr < prev    next >
Encoding:
Text File  |  1997-07-22  |  5.1 KB  |  149 lines
  1. library KeyHook;
  2.  
  3. uses
  4. {$IFDEF Ver80}
  5.   WinProcs,
  6.   WinTypes;
  7. {$ELSE}
  8.   Windows,
  9.   Messages;
  10. {$ENDIF}
  11.  
  12. var
  13.   Hook : HHOOK;
  14.   WM_ToggleIcon,
  15.   WM_TranslateKeys : Cardinal;
  16.   ComposeMode,
  17.   FirstKeyEntered : boolean;
  18.   FirstKey,SecondKey : word;
  19.  
  20. {$IFDEF Ver80}
  21. type
  22.   wParam = Word;
  23.   lParam = Longint;
  24.   LResult = Longint;
  25. {$ENDIF}
  26.  
  27. function HookProcedure(nCode: Integer; vkCode: WPARAM; MsgInfo: LPARAM) : LRESULT;
  28.                                                {$IFDEF Ver80} export {$ELSE} stdcall {$ENDIF};
  29.  
  30. const
  31.   ExcludedKeys = [VK_SHIFT,VK_MENU,VK_CONTROL,VK_LWIN,VK_RWIN,VK_APPS];
  32.  
  33. var
  34.   KeyState : TKeyboardState;
  35.   Buffer : array[0..2] of char;
  36.   ToASCIIResult : integer;
  37. begin
  38.   { only act on keystroke if it is being removed from the queue;
  39.     if PeekMessage with PM_NOREMOVE triggered this event, not removing the keystroke, then
  40.     nCode will be HC_NOREMOVE }
  41.   if (nCode = HC_ACTION) then begin
  42.     { by default, don't allow keystroke to be passed to designated window;
  43.       this will be changed if our three Compose checks fail and we call CallNextHookEx }
  44.     Result := 1;
  45.     if (vkCode = VK_CONTROL) and
  46.       ((HiWord(MsgInfo) and KF_UP) <> 0) and        { key is being released }
  47.       ((HiWord(MsgInfo) and KF_EXTENDED) <> 0) then begin
  48.         { right control key pressed; switch tray icon to active colour
  49.           and set ComposeMode flag to true, so it will cpature next two keystrokes }
  50.         PostMessage(HWND_BROADCAST,WM_ToggleIcon,1,0);
  51.         ComposeMode := true;
  52.         exit; { bypass CallNextHookEx, since we don't want right control key going to app }
  53.     end
  54.     else if (ComposeMode) and
  55.       ((HiWord(MsgInfo) and KF_UP) = 0) and    { key being pressed }
  56.       (not (vkCode in ExcludedKeys)) then begin  { key not the shift key }
  57.         if not FirstKeyEntered then begin
  58.           GetKeyboardState(KeyState);
  59. {$IFDEF Ver80}
  60.           ToASCIIResult := ToASCII(vkCode,MapVirtualKey(vkCode,0),@KeyState,@Buffer,0);
  61. {$ELSE}
  62.           ToASCIIResult := ToASCII(vkCode,MapVirtualKey(vkCode,0),KeyState,Buffer,0);
  63. {$ENDIF}
  64.           if ToASCIIResult = 0 then
  65.             FirstKey := 0
  66.           else if ToASCIIResult > 0 then
  67.             FirstKey := ord(Buffer[0])
  68.           else if ToASCIIResult < 0 then begin
  69.           { a dead key has been entered; exit compose
  70.             mode and let Windows take care of composing character itself }
  71.             PostMessage(HWND_BROADCAST,WM_ToggleIcon,0,0);
  72.             ComposeMode := false;
  73.             FirstKeyEntered := false;
  74.             Result := CallNextHookEx(0, nCode, vkCode, MsgInfo);
  75.             exit;
  76.           end;
  77.  
  78.           FirstKeyEntered := true;
  79.           exit; { bypass CallNextHook }
  80.         end
  81.         else begin
  82.           GetKeyboardState(KeyState);
  83. {$IFDEF Ver80}
  84.           ToASCIIResult := ToASCII(vkCode,MapVirtualKey(vkCode,0),@KeyState,@Buffer,0);
  85. {$ELSE}
  86.           ToASCIIResult := ToASCII(vkCode,MapVirtualKey(vkCode,0),KeyState,Buffer,0);
  87. {$ENDIF}
  88.           if ToASCIIResult = 0 then
  89.             SecondKey := 0
  90.           else if ToASCIIResult > 0 then
  91.             SecondKey := ord(Buffer[0])
  92.           else if ToASCIIResult < 0 then begin
  93.           { a dead key has been entered; exit compose
  94.             mode and let Windows take care of composing character itself }
  95.             PostMessage(HWND_BROADCAST,WM_ToggleIcon,0,0);
  96.             ComposeMode := false;
  97.             FirstKeyEntered := false;
  98.             Result := CallNextHookEx(0, nCode, vkCode, MsgInfo);
  99.             exit;
  100.           end;
  101.  
  102.           PostMessage(HWND_BROADCAST,WM_ToggleIcon,0,0);
  103.           ComposeMode := false;
  104.           FirstKeyEntered := false;
  105.           { pass the captured keys and the handle of the window with focus
  106.             (which sent these keys) to calling program, where the keys will
  107.             be translated and the resulting char sent to the GetFocuse window.
  108.             Could do translation here, but it is easier to modify the list
  109.             of characters and their two-key compose seqeunces from the calling program }
  110. {$IFDEF Ver80}
  111.           PostMessage(HWND_BROADCAST,WM_TranslateKeys,word(FirstKey + (SecondKey shl 8)),GetFocus);
  112. {$ELSE}
  113.           PostMessage(HWND_BROADCAST,WM_TranslateKeys,MAKELONG(FirstKey,SecondKey),GetFocus);
  114. {$ENDIF}
  115.           exit; { bypass CallNextHook }
  116.         end;
  117.     end;
  118.   end;
  119.   { make sure this is always called when nCode < 0 (necessary for
  120.     Windows 3.1) }
  121.   Result := CallNextHookEx(0, nCode, vkCode, MsgInfo);
  122. end;
  123.  
  124. procedure EnableHook; {$IFDEF Ver80} export {$ELSE} stdcall {$ENDIF};
  125. begin
  126.   { initialize state flags }
  127.   ComposeMode := false;
  128.   FirstKeyEntered := false;
  129. {$IFDEF Ver80}
  130.   Hook := SetWindowsHookEx(WH_KEYBOARD, HookProcedure, hInstance, 0);
  131. {$ELSE}
  132.   Hook := SetWindowsHookEx(WH_KEYBOARD, @HookProcedure, hInstance, 0);
  133. {$ENDIF}
  134. end;
  135.  
  136. procedure DisableHook; {$IFDEF Ver80} export {$ELSE} stdcall {$ENDIF};
  137. begin
  138.   UnhookWindowsHookEx(Hook);
  139. end;
  140.  
  141. exports
  142.   EnableHook,
  143.   DisableHook;
  144.  
  145. begin  
  146.   WM_ToggleIcon := RegisterWindowMessage('DCompose ToggleIcon');
  147.   WM_TranslateKeys := RegisterWindowMessage('DCompose TranslateKeys');
  148. end.
  149.